home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / jpi / sound.bas < prev    next >
Encoding:
BASIC Source File  |  1998-01-21  |  4.8 KB  |  150 lines
  1. Attribute VB_Name = "Sound"
  2. Public Const LOOPSOUNDINDEX = 8
  3. Global Const SoundEvent_Fire = 1
  4. Global Const SoundEvent_Explode = 2
  5. Global Const SoundEvent_Spawn = 3
  6. Global Const SoundEvent_BuildObject = 3
  7.  
  8. Type SoundObj
  9.   EventSounds(10) As Integer
  10. End Type
  11.  
  12. Global Const NOSOUND = -1
  13. Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal source As Long, ByVal length As Long)
  14. Private Declare Function lstrcpy Lib "Kernel32" (ByVal lpszDestinationString1 As Any, ByVal lpszSourceString2 As Any) As Long
  15.  
  16. Public Const MaxSndFiles = 100
  17. Public SoundOn As Boolean
  18. Const NOSOUNDFILE = ""
  19. Private Type sndfiles
  20.   Filename As String
  21.   SoundName As String
  22. End Type
  23. Private Type Snd
  24.   SoundFiles(MaxSndFiles) As sndfiles
  25.   MaxSoundFiles As Integer
  26.   CurrentFile  As String
  27.   DeviceOn As Boolean
  28. End Type
  29. Public SoundData As Snd
  30. Dim DS As DirectSound
  31. Public Const MaxSoundsPlaying = 7
  32. Public CurrentSoundChannel As Integer
  33. Dim SoundsPlaying(1 To MaxSoundsPlaying + 1) As DirectSoundBuffer
  34. Public Sub LoadSoundData()
  35. Call FileFunctions.OpenGameFile(File_SoundDefinitions, 1)
  36. Do
  37.   Line Input #1, a$
  38.   If a$ = FILETAG_ENDFILE Then Exit Do
  39.   If a$ = "[SOUNDDEF]" Then
  40.     soundfilenum = soundfilenum + 1
  41.     Line Input #1, a$
  42.     propvalue$ = MiscFunctions.GetPropertyValue(a$)
  43.     SoundData.SoundFiles(soundfilenum).SoundName = propvalue$
  44.     Line Input #1, a$
  45.     propvalue$ = MiscFunctions.GetPropertyValue(a$)
  46.     SoundData.SoundFiles(soundfilenum).Filename = Directory_GameData & Directory_Sound & propvalue$
  47.   End If
  48. Loop
  49. Close #1
  50. SoundData.MaxSoundFiles = soundfilenum
  51. End Sub
  52. Sub InitializeSound()
  53. DirectSoundCreate ByVal 0&, DS, Nothing
  54. DS.SetCooperativeLevel ViewForm.hwnd, DSSCL_NORMAL
  55. End Sub
  56. Public Sub UnInitializeSound()
  57. For I = 1 To MaxSoundsPlaying
  58.   Set SoundsPlaying(I) = Nothing
  59. Next I
  60. Set SoundsPlaying(LOOPSOUNDINDEX) = Nothing
  61. Set DS = Nothing
  62. End Sub
  63.  
  64. '
  65. ' Loads a Wave file into a direct sound buffer
  66. '
  67. Public Sub LoadWAVIntoDSB(Lds As DirectSound, ByVal fName As String, Ldsb As DirectSoundBuffer)
  68.     
  69.     Dim hWave As Long
  70.     Dim pcmwave As WAVEFORMATEX
  71.     Dim lngSize As Long
  72.     Dim lngPosition As Long
  73.     Dim ptr1 As Long, ptr2 As Long, lng1 As Long, lng2 As Long
  74.     Dim aByte() As Byte
  75.     
  76.     ReDim aByte(1 To FileLen(fName))
  77.     hWave = FreeFile
  78.     Open fName For Binary As hWave
  79.     Get hWave, , aByte
  80.     Close hWave
  81.     lngPosition = 1
  82.     While Chr$(aByte(lngPosition)) + Chr$(aByte(lngPosition + 1)) + Chr$(aByte(lngPosition + 2)) <> "fmt"
  83.         lngPosition = lngPosition + 1
  84.     Wend
  85.     CopyMemory VarPtr(pcmwave), VarPtr(aByte(lngPosition + 8)), Len(pcmwave)
  86.     While Chr$(aByte(lngPosition)) + Chr$(aByte(lngPosition + 1)) + Chr$(aByte(lngPosition + 2)) + Chr$(aByte(lngPosition + 3)) <> "data"
  87.         lngPosition = lngPosition + 1
  88.     Wend
  89.     CopyMemory VarPtr(lngSize), VarPtr(aByte(lngPosition + 4)), Len(lngSize)
  90.     Dim dsbd As DSBUFFERDESC
  91.     With dsbd
  92.         .dwSize = Len(dsbd)
  93.         .dwFlags = DSBCAPS_CTRLDEFAULT
  94.         .dwBufferBytes = lngSize
  95.         .lpwfxFormat = VarPtr(pcmwave)
  96.     End With
  97.     Lds.CreateSoundBuffer dsbd, Ldsb, Nothing
  98.     Ldsb.Lock 0&, lngSize, ptr1, lng1, ptr2, lng2, 0&
  99.     CopyMemory ptr1, VarPtr(aByte(lngPosition + 4 + 4)), lng1
  100.     If lng2 <> 0 Then
  101.         CopyMemory ptr2, VarPtr(aByte(lngPosition + 4 + 4 + lng1)), lng2
  102.     End If
  103.     
  104. End Sub
  105. Function GetSoundIndex(SoundName)
  106. For I = 1 To MaxSndFiles
  107.   If SoundData.SoundFiles(I).SoundName = SoundName Then
  108.     GetSoundIndex = I
  109.     Exit For
  110.   End If
  111. Next I
  112. End Function
  113. '
  114. ' Plays a sound
  115. '
  116. Public Sub Play_Sound(SChannel As Integer, Pan, Volume)
  117.   If SoundData.DeviceOn = True Then
  118.     On Error Resume Next
  119.     Dim lngFlag As Long, tempVol As Long
  120.     tempVol = Volume
  121.     CurrentSoundChannel = CurrentSoundChannel + 1
  122.     If CurrentSoundChannel > MaxSoundsPlaying Then CurrentSoundChannel = 1
  123.     SoundsPlaying(CurrentSoundChannel).Stop
  124.     Set SoundsPlaying(CurrentSoundChannel) = Nothing
  125.     Sound.LoadWAVIntoDSB DS, SoundData.SoundFiles(SChannel).Filename, SoundsPlaying(CurrentSoundChannel)
  126.     SoundsPlaying(CurrentSoundChannel).SetPan Pan
  127.     SoundsPlaying(CurrentSoundChannel).Play 0, 0, 0
  128.   End If
  129. End Sub
  130. Public Sub Play_LoopSound(SChannel As Integer, Volume)
  131.     Dim tempVol As Long
  132.     tempVol = Volume
  133.     Set SoundsPlaying(LOOPSOUNDINDEX) = Nothing
  134.     Sound.LoadWAVIntoDSB DS, SoundData.SoundFiles(SChannel).Filename, SoundsPlaying(LOOPSOUNDINDEX)
  135.     SoundsPlaying(LOOPSOUNDINDEX).Play 0, 0, DSBPLAY_LOOPING
  136. End Sub
  137.  
  138. '
  139. ' Stops a sound
  140. '
  141. Public Sub Stop_Sounds()
  142.     On Error Resume Next
  143.     Dim lngFlag As Long
  144.     For I = 1 To MaxSoundsPlaying
  145.       SoundsPlaying(I).Stop
  146.     Next I
  147.     SoundsPlaying(LOOPSOUNDINDEX).Stop
  148. End Sub
  149.  
  150.